home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / PRG / ICProgKit 1.3.sit / ICProgKit1.3 / Goodies / ICeTEe / LowLevel.p < prev    next >
Text File  |  1992-11-05  |  5KB  |  227 lines
  1. unit LowLevel;
  2. (*
  3. # Copyright Department of Computer Science
  4. # University of Western Australia
  5. # Created : Quinn
  6. # Station : Eriodon
  7. # Date : Monday, 4 November 1991
  8.  
  9. Really sleasy stuff that it not for the faint of heart.
  10.  
  11. *)
  12. interface
  13.  
  14. {$ifc undefined THINK_Pascal}
  15.     uses
  16.         Types;
  17. {$endc}
  18.  
  19. (* Global Bashing - Get constants from SysEqu.p *)
  20.     function GetGlobalSignedByte (ad: univ longint): SignedByte;
  21.         inline
  22.             $205F,                    (* move.l    (sp)+,a0                            *)
  23.             $1E90;                    (* move.b    (a0),(sp)                            *)
  24.  
  25.     procedure SetGlobalSignedByte (ad: univ longint; b: SignedByte);    (* not univ cause I dont trust Pascal *)
  26.         inline
  27.             $205F,                    (* move.l    (sp)+,a0                            *)
  28.             $1097,                    (* move.b    (sp),(a0)                            *)
  29.             $548F;                    (* addq.l    #2,sp                                    *)
  30.             (* I dont use autoincrement because I'm paranoid    *)
  31.             
  32.     function GetGlobalByte (ad: univ longint): integer;
  33.         inline
  34.             $205F,                    (* move.l    (sp)+,a0                            *)
  35.             $7000,                    (* moveq.l    #0,d0                                *)
  36.             $1010,                    (* move.b    (a0),d0                                *)
  37.             $3E80;                    (* move.w    d0,(sp)                                *)
  38.  
  39.     procedure SetGlobalByte (ad: univ longint; n: univ integer); (* integer for ease of use *)
  40.         inline
  41.             $301F,                    (* move.w    (sp)+,d0                            *)
  42.             $205F,                    (* move.l (sp)+,a0                            *)
  43.             $1080;                    (* move.b    d0,(a0)                                *)
  44.  
  45.     function GetGlobalW (ad: univ longint): integer;
  46.         inline
  47.             $205F,                    (* move.l    (sp)+,a0                            *)
  48.             $3E90;                    (* move.w    (a0),(sp)                            *)
  49.             
  50.     procedure SetGlobalW (ad: univ longint; w: univ integer);
  51.         inline
  52.             $301F,                    (* move.w    (sp)+,d0                            *)
  53.             $205F,                    (* move.l    (sp)+,a0                            *)
  54.             $3080;                    (* move.w    d0,(a0)                                *)
  55.  
  56.     function GetGlobalL (ad: univ longint): longint;
  57.         inline
  58.             $205F,                    (* move.l    (sp)+,a0                            *)
  59.             $2E90;                    (* move.l    (a0),(sp)                            *)
  60.  
  61.     procedure SetGlobalL (ad: univ longint; l: univ longint);
  62.         inline
  63.             $201F,                    (* move.l    (sp)+,d0                            *)
  64.             $205F,                    (* move.l    (sp)+,a0                            *)
  65.             $2080;                    (* move.l    d0,(a0)                                *)
  66.  
  67.     function GetGlobalString (ad: univ longint): Str255;
  68.     procedure SetGlobalString (ad: univ longint; s: Str255); (* only bashes len+1 chars *)
  69.  
  70. (* Calling *)
  71.     procedure CallProcPtr (ad: univ ProcPtr);
  72.     inline
  73.         $205F, (* move.l    (a7)+,a0        ; pop proc address    *)
  74.         $4E90; (* jsr            (a0)                ; call proc                    *)
  75.  
  76. (* Pointer Arithmetic *)
  77.     function AddPtrLong (p: univ Ptr; offset: longint): Ptr;
  78.     inline
  79.         $201F,    (* move.l    (sp)+,d0    ; pop offset *)
  80.         $D09F,    (* add.l    (sp)+,d0    ; add ptr to offset (and pop p) *)
  81.         $2E80;    (* move.l    d0,(sp)        ; place in result *)
  82.  
  83.     procedure OffsetPtr (var p: univ Ptr; offset: longint);
  84.     inline
  85.         $201F,    (* move.l    (sp)+,d0    ; pop offset *)
  86.         $205F,    (* move.l    (sp)+,a0    ; pop address of p *)
  87.         $D190;    (* add.l    d0,(a0)        ; add offset to p *)
  88.  
  89.     function SubPtrPtr (leftp, rightp: univ Ptr): longint;
  90.     inline
  91.         $201F,    (* move.l    (sp)+,d0    ; pop rightp *)
  92.         $A055,    (* _StripAddress        ; strip if needed *)
  93.         $2200,    (* move.l    d0,d1            ; store in d1 *)
  94.         $201F,    (* move.l    (sp)+,d0    ; pop leftp *)
  95.         $A055,    (* _StripAddress        ; strip if needed (reg traps preserve d1) *)
  96.         $9081,    (* sub.l    d1,d0            ; d0 := leftp - rightp *)
  97.         $2E80;    (* move.l    d0,(sp)        ; place result *)
  98.  
  99. (* Register Getting - Address *)
  100.  
  101.     function GetRegA0: Ptr;
  102.     inline
  103.         $2E88; (* movea.l    a0,(sp)        ; fetch a0 into tos    *)
  104.     function GetRegA1: Ptr;
  105.     inline
  106.         $2E89;
  107.     function GetRegA2: Ptr;
  108.     inline
  109.         $2E8A;
  110.     function GetRegA3: Ptr;
  111.     inline
  112.         $2E8B;
  113.     function GetRegA4: Ptr;
  114.     inline
  115.         $2E8C;
  116.     function GetRegA5: Ptr;
  117.     inline
  118.         $2E8D;
  119.     function GetRegA6: Ptr;
  120.     inline
  121.         $2E8E;
  122.     function GetRegA7: Ptr;
  123.     inline
  124.         $2E8F;
  125.  
  126. (* Register Setting - Address *)
  127.  
  128.     procedure SetRegA0 (n: univ Ptr);
  129.     inline
  130.         $205F; (* movea.l    (sp)+,a0        ; pop n into a0    *)
  131.     procedure SetRegA1 (n: univ Ptr);
  132.     inline
  133.         $225F;
  134.     procedure SetRegA2 (n: univ Ptr);
  135.     inline
  136.         $245F;
  137.     procedure SetRegA3 (n: univ Ptr);
  138.     inline
  139.         $265F;
  140.     procedure SetRegA4 (n: univ Ptr);
  141.     inline
  142.         $285F;
  143.     procedure SetRegA5 (n: univ Ptr);
  144.     inline
  145.         $2A5F;
  146.     procedure SetRegA6 (n: univ Ptr);
  147.     inline
  148.         $2C5F;
  149.     procedure SetRegA7 (n: univ Ptr);
  150.     inline
  151.         $2E5F;
  152.  
  153. (* Register Getting - Data *)
  154.  
  155.     function GetRegD0: longint;
  156.     inline
  157.         $2E80; (* move.l    d0,(sp)        ; fetch d0 into tos    *)
  158.     function GetRegD1: longint;
  159.     inline
  160.         $2E81;
  161.     function GetRegD2: longint;
  162.     inline
  163.         $2E82;
  164.     function GetRegD3: longint;
  165.     inline
  166.         $2E83;
  167.     function GetRegD4: longint;
  168.     inline
  169.         $2E84;
  170.     function GetRegD5: longint;
  171.     inline
  172.         $2E85;
  173.     function GetRegD6: longint;
  174.     inline
  175.         $2E86;
  176.     function GetRegD7: longint;
  177.     inline
  178.         $2E87;
  179.  
  180. (* Register Setting - Data *)
  181.  
  182.     procedure SetRegD0 (n: univ longint);
  183.     inline
  184.         $201F; (* move.l    (sp)+,(d0)        ; pop n into d0    *)
  185.     procedure SetRegD1 (n: univ longint);
  186.     inline
  187.         $221F;
  188.     procedure SetRegD2 (n: univ longint);
  189.     inline
  190.         $241F;
  191.     procedure SetRegD3 (n: univ longint);
  192.     inline
  193.         $261F;
  194.     procedure SetRegD4 (n: univ longint);
  195.     inline
  196.         $281F;
  197.     procedure SetRegD5 (n: univ longint);
  198.     inline
  199.         $2A1F;
  200.     procedure SetRegD6 (n: univ longint);
  201.     inline
  202.         $2C1F;
  203.     procedure SetRegD7 (n: univ longint);
  204.     inline
  205.         $2E1F;
  206.  
  207. implementation
  208.  
  209. {$ifc undefined THINK_Pascal}
  210.     uses
  211.         Memory;
  212. {$endc}
  213.  
  214.     function GetGlobalString (ad: univ longint): Str255;
  215.         var
  216.             tmp: Str255;
  217.     begin
  218.         BlockMove(pointer(ad), @tmp, sizeof(tmp));
  219.         GetGlobalString := tmp;
  220.     end; (* GetGlobalB *)
  221.  
  222.     procedure SetGlobalString (ad: univ longint; s: Str255); (* only bashes len+1 chars *)
  223.     begin
  224.         BlockMove(@s, pointer(ad), Length(s) + 1);
  225.     end; (* GetGlobalB *)
  226.  
  227. end. (* LowLevel *)